      SUBROUTINE SETUP
      RETURN
      END
C   HS54 SCALED
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA NAME/'HS54SCAL'/
      DATA (X(I),I=1,6)/-.5D0,.20D0, 2.D0,-8.D-2,0.D0,-5.D-2/
      DATA N/6/ , NH/1/ , NG/12/
      DATA DEL0/1.00D0/ ,TAU0/1.00D0/ ,TAU/.1D0/
      DATA (GUNIT(1,J),J=2,13)/12*1/,(GUNIT(3,I),I=2,13)/6*1,6*-1/,
     F     (GUNIT(2,I),I=2,13)/1,2,3,4,5,6,
     F     1,2,3,4,5,6/
     F     ,((GUNIT(I,J),I=1,3),J=0,1)/-1,0,0,-1,0,0/
      END
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      DOUBLE PRECISION X(NX),FX,Y1,Y2,Y3,Y4,Y5,Y6
      ICF=ICF+1
      Y1=X(1)
      Y2=X(2)
      Y3=X(3)
      Y4=X(4)
      Y5=X(5)
      Y6=X(6)
      ICF=ICF+1
      FX=-DEXP(-((Y1**2+Y1*Y2+6.25D0*Y2**2)/.96D0+Y3**2
     1   /49.D0+4.D0*(Y4**2+Y5**2+Y6**2))*.5D0)
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      DOUBLE PRECISION X(NX),GRADF(NX),Y1,Y2,Y3,Y4,Y5,Y6,TERM
      ICGF=ICGF+1
      Y1=X(1)
      Y2=X(2)
      Y3=X(3)
      Y4=X(4)
      Y5=X(5)
      Y6=X(6)
      TERM=DEXP(-((Y1**2+Y1*Y2+6.25D0*Y2**2)/.96D0+Y3**2/49.D0+
     1           4.D0*(Y4**2+Y5**2+Y6**2))*.5D0)*.5D0
      ICGF=ICGF+1
      GRADF(1)= TERM*((Y1+Y1+Y2)/.96D0)
      GRADF(2)= TERM*(Y1+1.25D1*Y2)/.96D0
      GRADF(3)= TERM*Y3/24.5D0
      GRADF(4)= 8.D0*TERM*Y4
      GRADF(5)= 8.D0*TERM*Y5
      GRADF(6)= 8.D0*TERM*Y6
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI
      CRES(I)=CRES(I)+1
      HXI=X(1)*.8D0+X(2)-.36D0
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX),GRADHI(NX),H(6)
      SAVE H
      DATA H/.8D0,1.D0,4*0.D0/
      CGRES(I)=CGRES(I)+1
      DO      100      J=1,6
      GRADHI(J)=H(J)
  100 CONTINUE
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),OG(6),UG(6),GXI
      SAVE UG,OG
      DATA OG/1.25D0,3.6D0,8.D0,.1D0,9.99D0,.1D0/
      DATA UG/-1.25D0,-4.4D0,-2.D0,-.1D0,-10.01D0,-.1D0/
      IF ( GUNIT(1,I+NH) .EQ. -1 ) CRES(I+NH)=CRES(I+NH)+1
      IF(I.GT.6)      GOTO 100
      GXI=X(I)-UG(I)
      RETURN
  100 CONTINUE
      GXI=OG(I-6)-X(I-6)
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX) ,GRADGI(NX)
      DO      100      J=1,6
      GRADGI(J)=0.D0
  100 CONTINUE
       IF(I.LE.6)     GRADGI(I)=1.D0
       IF(I.GT.6)     GRADGI(I-6)=-1.D0
      RETURN
      END


